Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue55/Alfresco/AAThread.pas

Pascal/Delphi Source File | 2000-02-10 | 5.4 KB | 200 lines

{*********************************************************}
{* AAThread                                              *}
{* Copyright (c) Julian M Bucknall 1998-2000             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco threading stuff                   *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AAThread;

interface

{$IFNDEF Win32}
!! Error - this unit is for 32-bit Windows only
{$ENDIF}

uses
  Windows, SysUtils;

type
  TaaReadWriteSync = class
    private
      FBlockedReaders : THandle; {a semaphore}
      FBlockedWriters : THandle; {a semaphore}
      FController     : THandle; {a mutex}
      FActiveReaders  : integer;
      FActiveWriter   : boolean;
      FWaitingReaders : integer;
      FWaitingWriters : integer;
    protected
    public
      constructor Create;
      destructor Destroy; override;

      procedure StartReading;
      procedure StartWriting;
      procedure StopReading;
      procedure StopWriting;
  end;

implementation

{===Helper routines==================================================}
procedure RandomSyncObjName(aDest : PChar; const aRootName : string);
var
  Len : integer;
  i   : integer;
begin
  Len := length(aRootName);
  StrCopy(aDest, PChar(aRootName));
  inc(aDest, Len);
  aDest^ := '/';
  inc(aDest);
  for i := 1 to 10 do begin
    aDest^ := chr(Random(26) + ord('A'));
    inc(aDest);
  end;
  aDest^ := #0;
end;
{====================================================================}


{====================================================================}
constructor TaaReadWriteSync.Create;
var
  NameZ : array [0..MAX_PATH] of char;
begin
  inherited Create;
  {create the primitive synchronization objects}
  RandomSyncObjName(NameZ, 'aaRW.BlockedReaders');
  FBlockedReaders := CreateSemaphore(nil, 0, 127, NameZ);
  RandomSyncObjName(NameZ, 'aaRW.BlockedWriters');
  FBlockedWriters := CreateSemaphore(nil, 0, 1, NameZ);
  RandomSyncObjName(NameZ, 'aaRW.Controller');
  FController := CreateMutex(nil, false, NameZ);
end;
{--------}
destructor TaaReadWriteSync.Destroy;
begin
  CloseHandle(FBlockedReaders);
  CloseHandle(FBlockedWriters);
  CloseHandle(FController);
  inherited Destroy;
end;
{--------}
procedure TaaReadWriteSync.StartReading;
var
  HaveToWait : boolean;
begin
  {acquire the controlling mutex}
  WaitForSingleObject(FController, INFINITE);

  {if there is a writer executing or there is at least one writer
   waiting, add ourselves as a waiting reader, make sure we wait}
  if FActiveWriter or (FWaitingWriters <> 0) then begin
    inc(FWaitingReaders);
    HaveToWait := true;
  end

  {otherwise, add ourselves as another executing reader, and make sure
   we don't wait}
  else begin
    inc(FActiveReaders);
    HaveToWait := false;
  end;

  {release the controlling mutex}
  ReleaseMutex(FController);

  {if we have to wait, then do so}
  if HaveToWait then
    WaitForSingleObject(FBlockedReaders, INFINITE);
end;
{--------}
procedure TaaReadWriteSync.StartWriting;
var
  HaveToWait : boolean;
begin
  {acquire the controlling mutex}
  WaitForSingleObject(FController, INFINITE);

  {if there are readers or another writer running, add ourselves as a
   waiting writer, and make sure we wait}
  if FActiveWriter or (FActiveReaders <> 0) then begin
    inc(FWaitingWriters);
    HaveToWait := true;
  end

  {otherwise, add ourselves as another executing writer, and make sure
   we don't wait}
  else begin
    FActiveWriter := true;
    HaveToWait := false;
  end;

  {release the controlling mutex}
  ReleaseMutex(FController);

  {if we have to wait, then do so}
  if HaveToWait then
    WaitForSingleObject(FBlockedWriters, INFINITE);
end;
{--------}
procedure TaaReadWriteSync.StopReading;
begin
  {acquire the controlling mutex}
  WaitForSingleObject(FController, INFINITE);

  {we're finishing reading}
  dec(FActiveReaders);

  {if we are the last reader in this cycle, and there is at least one
   writer waiting, release it}
  if (FActiveReaders = 0) and (FWaitingWriters <> 0) then begin
    dec(FWaitingWriters);
    FActiveWriter := true;
    ReleaseSemaphore(FBlockedWriters, 1, nil);
  end;

  {release the controlling mutex}
  ReleaseMutex(FController);
end;
{--------}
procedure TaaReadWriteSync.StopWriting;
var
  i : integer;
begin
  {acquire the controlling mutex}
  WaitForSingleObject(FController, INFINITE);

  {we're finishing writing}
  FActiveWriter := false;

  {if there is at least one reader waiting, release them all}
  if (FWaitingReaders <> 0) then begin
    for i := pred(FWaitingReaders) downto 0 do begin
      dec(FWaitingReaders);
      inc(FActiveReaders);
      ReleaseSemaphore(FBlockedReaders, 1, nil);
    end;
  end

  {otherwise, if there is at least one waiting writer, release one}
  else if (FWaitingWriters <> 0) then begin
    dec(FWaitingWriters);
    FActiveWriter := true;
    ReleaseSemaphore(FBlockedWriters, 1, nil);
  end;

  {release the controlling mutex}
  ReleaseMutex(FController);
end;
{====================================================================}

end.